home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / ad.arc / ADMAIN.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  13.5 KB  |  285 lines
  1. 1  '     ******************************************************************              *                                                                *
  2. 2  '     *                         ADDRESS BOOK                           *              *                                                                *
  3. 3  '     *                 INTEGRATED SOFTWARE SYSTEMS                    *              *                                                                *
  4. 4  '     *                      PHOENIX, MD  21131                        *              *                                                                *
  5. 5  '     *           (C) COPYRIGHT 1983  E. L. LOH AND R. L. CARET        *              *                                                                *
  6. 6  '     *                          Version 2.1                           *              *                                                                *
  7. 7  '     ******************************************************************
  8. 10  OPEN "TEMPOR.TEM" FOR INPUT AS #1:INPUT #1, FILE$,FILM$,FIL$:CLOSE #1
  9. 20  DIM D$(2),ZK(40):GOSUB 8000:GOSUB 8150:GOTO 540
  10. 200  SCREEN 0,0 :WIDTH 80:COLOR 3,0:DIM ZK(40):GOSUB 8100:GOSUB 8150
  11. 210  DIM DQ$(12):FOR I= 1 TO 12:READ DQ$(I):NEXT
  12. 220  DATA JANUARY, FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER
  13. 240  T1$="The Address Book"
  14. 250  CLS:GOSUB 1315:NRED=0:LOCATE 1,1
  15. 300  F1$=F$+"*.DAT"
  16. 310  PRINT STRING$(75,157):PRINT "DIRECTORY:  FILES ON DRIVE ";:COLOR 12,0:PRINT F$;:COLOR 3,0:PRINT " ARE:":PRINT:IF FF$="Y" THEN 315 ELSE GOSUB 40000:GOTO 325
  17. 315  FILES F1$
  18. 325  PRINT :PRINT STRING$(75,157):GOTO 430
  19. 340  REM
  20. 350  LOCATE 5,1:PRINT "CHOOSE ONE OF THE FOLLOWING:  "
  21. 354  COLOR 14,0:PRINT :PRINT "   ";CHR$(186);"     ";O$:PRINT "   ";CHR$(186);"     ";O1$:PRINT "   ";CHR$(25);"     ";O2$:COLOR 3,0
  22. 356  PRINT:PRINT "   C)REATE New File"
  23. 357  PRINT "   L)OAD DATA DISK"
  24. 358  COLOR 14,0:LOCATE 11,4:PRINT "C":LOCATE 12,4:PRINT "L":COLOR 31,0:LOCATE 8,11:PRINT "?":COLOR 3,0
  25. 360  GOSUB 6000
  26. 362  COLOR 3,0:LOCATE 8,11:PRINT Y$
  27. 365  IF Y$="C" THEN 380
  28. 370  IF Y$="L" THEN 420 ELSE 350
  29. 380  LOCATE 17,1:INPUT "Enter FILE you would like to create ... " ,FIL$:IF LEN(FIL$)=0 THEN 380
  30. 385  S=INSTR(1,FIL$,":"):IF S=0 THEN FIL$=F$+FIL$
  31. 390  S=INSTR(1,FIL$,"."):IF S<>0 THEN FIL$=LEFT$(FIL$,S-1)
  32. 400  FILE$=FIL$+".DAT":FILM$=FIL$+".ISS"
  33. 405  IF Y$="C" THEN GOSUB 8200:YST=1:YC=1:GOSUB 8000:GOTO 740 ELSE 535
  34. 420  COLOR 3,0:LOCATE 17,1:PRINT STRING$(75,157)
  35. 425  DEF SEG=0: POKE 1050, PEEK(1052)
  36. 430  LOCATE ,,1:GOSUB 10010:COLOR 1,11:PRINT:PRINT "Enter FILE you would like to EXAMINE ... ";:COLOR 14,0:INPUT "  ",FIL$:COLOR 3,0
  37. 435  S=INSTR(1,FIL$,":"):IF S=0 THEN FIL$=F$+FIL$
  38. 440  S=INSTR(1,FIL$,"."):IF S<>0 THEN FIL$=LEFT$(FIL$,S-1)
  39. 450  FILE$=FIL$+".DAT":FILM$=FIL$+".ISS"
  40. 530  IF Y$="C" THEN 740
  41. 535  GOSUB 8200:YST=1:GOSUB 8000:
  42. 540  ON KEY(1) GOSUB 540:KEY(1) ON:DEF SEG = &H40:POKE &H17,&H0
  43. 542  ON KEY(7) GOSUB 1360:KEY(7) ON:ON KEY(9) GOSUB 9000:KEY(9) ON:ON KEY(8) GOSUB 891:KEY (8) ON
  44. 544  ON KEY(2) GOSUB 1120:KEY(2) ON:ON KEY(3) GOSUB 1170:KEY(3) ON:ON KEY(4) GOSUB 1220:KEY(4) ON:ON KEY(5) GOSUB 1180:ON KEY(6) GOSUB 1260:KEY(6) ON:KEY(5) ON
  45. 550  CLS:LOCATE 25,10:COLOR 1,7,1:PRINT " FILE = ";FILE$;SPACE$(10);"MAIN MENU";SPACE$(10);"(C) ISS, INC.";:COLOR 3,0
  46. 560  LOCATE 1,1:PRINT TAB(10);"MAIN MENU":PRINT:PRINT "CHOOSE ONE OF THE FOLLOWING:  "
  47. 580  COLOR 14,0:PRINT :PRINT "   ";CHR$(186);"     ";O$:PRINT "   ";CHR$(186);"     ";O1$:PRINT "   ";CHR$(25);"     ";O2$:COLOR 3,0
  48. 590  PRINT :PRINT "Key F1 Return to MAIN Menu"
  49. 600  PRINT "Key F2  or E)DIT/ADD address "
  50. 605  PRINT "Key F3  or D)ELETE address "
  51. 610  PRINT "Key F4  or B)SORT Address Book
  52. 620  PRINT "Key F5  or S)EARCH Address Book"
  53. 625  PRINT "Key F6  or P)RINT Address Book"
  54. 630  PRINT "Key F7  or L)IST of names in Address Book "
  55. 640  PRINT "Key F8  or X)EXAMINE another file"
  56. 650  PRINT "Key F9  or F)ILE save/continue "
  57. 660  PRINT "Key F10 or T)RANSFER Records "
  58. 662  PRINT "Alt  Key F10 or C)REATE NEW Address Book"
  59. 665  PRINT "Ctrl Key F10 or Q)UIT - EXIT Address Book "
  60. 666  PRINT "Shift Key F10 - Change Display ":COLOR 14,0
  61. 670  LOCATE 19,17:PRINT "C":LOCATE 10,12:PRINT "E":LOCATE 11,12:PRINT "D":LOCATE 12,12:PRINT "B":LOCATE 13,12:PRINT "S":LOCATE 14,12:PRINT "P":LOCATE 15,12:PRINT "L":LOCATE 16,12:PRINT "X":LOCATE 17,12:PRINT "F":LOCATE 20,17:PRINT "Q"
  62. 675  LOCATE 9,5:PRINT "F1":LOCATE 19,1:PRINT "Alt":LOCATE 19,10:PRINT "F10":LOCATE 20,1:PRINT "Ctrl":LOCATE 20,10:PRINT "F10":LOCATE 21,1:PRINT "Shift":LOCATE 21,11:PRINT "F10"
  63. 680  LOCATE 10,5:PRINT "F2":LOCATE 11,5:PRINT "F3":LOCATE 12,5:PRINT "F4":LOCATE 13,5:PRINT "F5":LOCATE 14,5:PRINT "F6":LOCATE 15,5:PRINT "F7":LOCATE 16,5:PRINT "F8":LOCATE 17,5:PRINT "F9":LOCATE 18,5:PRINT "F10":LOCATE 18,12:PRINT "T"
  64. 700  COLOR 31,0:LOCATE 6,11:PRINT "?":LOCATE ,,0:COLOR 3,0
  65. 705  COLOR 14,0:LOCATE 22,50:PRINT "KEY  F1";:COLOR 3,0:PRINT " = MAIN MENU"
  66. 710  GOSUB 6000
  67. 715  IF LEN(Y$)<>1 AND ASC(RIGHT$(Y1$,1))=113 THEN 740
  68. 720  IF Y$="C" THEN GOSUB 8200:YST=1:YC=1:GOSUB 8000:GOTO 740 ELSE 825
  69. 740  X1$="NEW FILE":X3$="FILE = ":X5$="FUNCTION = ":X4$=SPACE$(20):Q$=CHR$(27)
  70. 750  GOSUB 1310
  71. 760  LOCATE 8,25:PRINT "You are creating a NEW file!":LOCATE 10,20:PRINT "The file ";:COLOR 9,0:PRINT FILE$;:COLOR 3,0:PRINT " will be overwritten!"
  72. 765  LOCATE 12,21:PRINT "Please ENTER <G> to continue,":LOCATE 13,34:PRINT "<R> to Return to MENU":COLOR 14,0:LOCATE 12,35:PRINT "G":LOCATE 13,35:PRINT "R":COLOR 3,0
  73. 770  DEF SEG=0: POKE 1050, PEEK(1052):GOSUB 10020
  74. 775  Y$=INKEY$:IF Y$="" THEN 775 ELSE Y$=CHR$(ASC(Y$) AND &HDF)
  75. 780  IF Y$="G" THEN I=1:NN=0:GOSUB 1120
  76. 790  IF Y$="R" THEN 540 ELSE 770
  77. 800  GOTO 740
  78. 810  IF Y$="G" THEN I=1:NN=0
  79. 820  IF Y$="G" THEN 1120
  80. 825  IF Y$="D" THEN 1170
  81. 826  IF LEN(Y1$)<>1 AND ASC(RIGHT$(Y1$,1))=113 THEN 740
  82. 827  IF ASC(RIGHT$(Y1$,1))=103 THEN GOSUB 900
  83. 828  IF ASC(RIGHT$(Y1$,1))=68 THEN 1195
  84. 829  IF RIGHT$(Y1$,1)="]" THEN  GOSUB 7500
  85. 830  IF Y$="E" THEN 1120
  86. 840  IF Y$="S" THEN 1180
  87. 845  IF Y$="L" THEN 1360
  88. 850  IF Y$="B" THEN 1220
  89. 860  IF Y$="F" THEN GOSUB 9000
  90. 870  IF Y$="P" THEN 1260
  91. 875  IF Y$="T" THEN 1195
  92. 880  IF Y$="X" THEN 891
  93. 890  IF Y$="Q" THEN GOSUB 900 ELSE GOSUB 10020:GOTO 710
  94. 891  CLS:LOCATE 25,20:COLOR 1,7,1:PRINT "FILE = ";FILE$;SPACE$(10);"FUNCTION = EXIT";:COLOR 3,0
  95. 892  LOCATE 12,12:PRINT "PLEASE CONFIRM BY ENTERING <";:COLOR 14,0:PRINT "YES";:COLOR 3,0:PRINT "> OR <";:COLOR 14,0:PRINT "NO";:COLOR 3,0:PRINT "> and ";:COLOR 14,0:PRINT ARR$;:GOSUB 10000:INPUT Y1$
  96. 893  IF INSTR("YESyesYes",Y1$) <>0 THEN CLEAR:CLOSE:DIM D$(2):KILL"TEMPOR.TEM":SNN$="0G110":GOTO 200 ELSE 550
  97. 900  CLS:LOCATE 25,20:COLOR 1,7,1:PRINT "FILE = ";FILE$;SPACE$(10);"FUNCTION = EXIT";:COLOR 3,0:LOCATE 10,5
  98. 911  LOCATE 12,12:PRINT "PLEASE CONFIRM BY ENTERING <";:COLOR 14,0:PRINT "YES";:COLOR 3,0:PRINT "> OR <";:COLOR 14,0:PRINT "NO";:COLOR 3,0:PRINT "> and ";:COLOR 14,0:PRINT ARR$;:COLOR 3,0:GOSUB 10000:INPUT " ",Y1$
  99. 920  IF INSTR("YESyesYes",Y1$) <>0 THEN 930 ELSE RETURN 540
  100. 930  CLS:LOCATE 1,1:PRINT "SIGNING OFF:  SELECT ..."
  101. 940  COLOR 14,0:PRINT :PRINT "   ";CHR$(186);"     ";O$:PRINT "   ";CHR$(186);"     ";O1$:PRINT "   ";CHR$(25);"     ";O2$:COLOR 3,0
  102. 950  PRINT:PRINT TAB(4);"E)XIT BASIC and Returns to DOS":PRINT TAB(4);"B)ACK to BASIC and CLEAR work area"
  103. 960  PRINT TAB(4);"R)ETURN to BASIC and prepare for another RUN":COLOR 14,0:LOCATE 7,4:PRINT "E":LOCATE 8,4:PRINT "B":LOCATE 9,4:PRINT "R":COLOR 31,0:LOCATE 4,11:PRINT "?":GOSUB 10010:COLOR 3,0
  104. 962  COLOR 14,0:LOCATE 22,50:PRINT "KEY  F1";:COLOR 3,0:PRINT " = MAIN MENU"
  105. 965  Y$=INKEY$:IF Y$="" THEN 965 ELSE Y$=CHR$(ASC(Y$) AND &HDF)
  106. 970  IF Y$="E" THEN CLS:SYSTEM
  107. 980  IF Y$="B" THEN CLS:LOCATE 12,38:PRINT "BYE":LOCATE 1,1:NEW:END
  108. 990  IF Y$="R" THEN CLS:LOCATE 12,38:PRINT "BYE":LOCATE 1,1:LOAD "ADSTART.BAS":KEY ON:END ELSE 960
  109. 1000  GOTO 550
  110. 1010  CLOSE
  111. 1011  IF (YC=1 AND ERL=8010) THEN I=1:NN=0:SNN$="0G110":PT$="":LP$="":Z$="":LP$="":RESUME 1120
  112. 1015  IF (YST=1 AND ERR=53) THEN NN=0:SNN$="0G110":PT$="":LP$="":Z$="":LP$="":RESUME 540
  113. 1020  IF ERR = 53 THEN CLS:LOCATE 25,10:COLOR 1,7,1:PRINT "FILE = ";FILE$;SPACE$(10);"FILE NOT FOUND";:COLOR 7,1:LOCATE 1,1
  114. 1030  IF ERR = 53 THEN PRINT "NO '....DAT' FILES ON ACTIVE DISK.":FOR I= 1 TO 500:NEXT I:RESUME 340
  115. 1040  IF ERR = 54 THEN CLS:LOCATE 25,10:COLOR 1,7,1:PRINT "FILE = ";FILE$;SPACE$(10);"BAD FILE MODE ";:COLOR 7,1:LOCATE 1,1
  116. 1050  IF ERR = 54 THEN PRINT "FILE DOES NOT EXIST":FOR I= 1 TO 1000:NEXT I:RESUME 340
  117. 1060  IF ERR = 61 THEN CLS:LOCATE 25,10:COLOR 1,7,1:PRINT "FILE = ";FILE$;SPACE$(10);"DISK FULL ";:COLOR 7,1:LOCATE 1,1
  118. 1070  IF ERR = 61 THEN PRINT "DISK FULL.  LOAD FORMATTED DISK AND 'CONTINUE' ":STOP
  119. 1080  IF ERR = 61 THEN RESUME 340
  120. 1090  CLS:LOCATE 12,28: PRINT "ERROR ";ERR;" ENCOUNTERED.":GOSUB 10010:FOR I= 1 TO 2000:NEXT I:GOTO 550
  121. 1100  RESUME 340
  122. 1120  REM
  123. 1130  IF YST=1 THEN GOSUB 1320
  124. 1140  IF (Y$="E" OR Y$="e") AND YST=1 THEN Y1=2:GOSUB 1440
  125. 1150  Z$="EDIT":GOSUB 9500
  126. 1160  RUN "ADEDIT.BAS"
  127. 1170  IF YST=1 THEN GOSUB 1320:Y1=3:GOSUB 1440
  128. 1175  Z$="DELETE" :GOSUB 9500
  129. 1177  RUN "ADDELETE.BAS"
  130. 1180  IF YST=1 THEN GOSUB 1320:Y1=5:GOSUB 1440
  131. 1185  Z$="SEARCH" :GOSUB 9500
  132. 1190  RUN "ADSEARCH.BAS"
  133. 1195  IF YST=1 THEN GOSUB 1320:Y1=5:GOSUB 1440
  134. 1200  Z$="TRANSFER":GOSUB 9500
  135. 1205  RUN "ADTRANS.BAS"
  136. 1220  IF YST=1 THEN GOSUB 1320:Y1=4:GOSUB 1440
  137. 1240  Z$="SORT" :GOSUB 9500
  138. 1250  RUN "ADSORT.BAS"
  139. 1260  REM
  140. 1275  Z$="PRINT"
  141. 1280  Y$="p"
  142. 1285  GOSUB 9500
  143. 1295  GOSUB 1320
  144. 1300  RUN "ADPRINT.BAS"
  145. 1310  CLS:LOCATE 25,5:COLOR 1,7,1:PRINT X3$;FILE$;X4$;X5$;X1$;:COLOR 3,0:LOCATE 1,1:RETURN
  146. 1315  LOCATE 25,10:COLOR 1,7,1:PRINT "INTEGRATED SOFTWARE SYSTEMS";SPACE$(15);"SERIAL NUMBER: ";SNN$;:COLOR 3,0:RETURN
  147. 1320  IF Y$="g" OR Y$="G" THEN 1340
  148. 1330  REM         TEMPORARY FILE
  149. 1340  OPEN FILM$ FOR OUTPUT AS #3
  150. 1350  WRITE #3,Y$,NRED,NN,FILE$,FIL$,PT$,SNN$,LP1,LP$,T1$,SND$,TN,F$
  151. 1355  FOR I=1 TO 36:WRITE #3, ZK(I):NEXT:CLOSE #3:RETURN
  152. 1360  GOSUB 1340:CLEAR:CHAIN "ADLIST.BAS",7000
  153. 1440  REM
  154. 1450  REM      FILES
  155. 1460  REM
  156. 1462  IF AX1$<>"**" THEN CLS:LOCATE 12,10: PRINT "Do you want to create a backup file?  <";:COLOR 14,0:PRINT "Y";:COLOR 3,0:PRINT ">es OR <";:COLOR 14,0:PRINT "N";:COLOR 3,0:PRINT ">o.":COLOR 3,0:GOSUB 10000
  157. 1464  Y$=INKEY$:IF Y$="" THEN 1464 ELSE Y$=CHR$(ASC(Y$) AND &HDF)
  158. 1466  IF Y$="N" THEN RETURN
  159. 1468  IF Y$="Y" THEN DIM V$(16):Y2=1:CHAIN "ADFILES",10,ALL ELSE 1464
  160. 6000  DEF SEG=0: POKE 1050, PEEK(1052):LOCATE 1,67:PRINT "(C) 1983":LOCATE 2,62:PRINT "Date:  ";DATE$:LOCATE 3,62:PRINT "Time:  "
  161. 6010  Y$=INKEY$:IF Y$="" THEN LOCATE 3,69:PRINT TIME$:GOTO 6010 ELSE Y1$=Y$:Y$=CHR$(ASC(Y$) AND &HDF):RETURN
  162. 6040  DEF SEG=0: POKE 1050, PEEK(1052):LOCATE 19,29:PRINT "Date:  ";DATE$:LOCATE 20,29:PRINT "Time:  ":GOSUB 10000
  163. 6050  LOCATE ,,0:Y$=INKEY$:IF Y$="" THEN LOCATE 20,36:PRINT TIME$:GOTO 6050 ELSE RETURN
  164. 6085  DEF SEG=0: POKE 1050, PEEK(1052):LOCATE 20,29:PRINT "Date:  ";DATE$:LOCATE 21,29:PRINT "Time:  ";TIME$:RETURN
  165. 7500  DEF SEG=&HB000
  166. 7505  POKE 0,&H33: MONO = (PEEK(0)=&H33)
  167. 7510  POKE 0,&H55: MONO = (PEEK(0)=&H55) AND MONO
  168. 7515  DEF SEG=&HB800
  169. 7520  POKE 0,&H33: COLR = (PEEK(0)=&H33):SNN$="OG110"
  170. 7525  POKE 0,&H55: COLR = (PEEK(0)=&H55) AND COLR
  171. 7530  IF MONO AND COLR THEN 7540
  172. 7535  IF MONO THEN RETURN 540
  173. 7536  IF COLR THEN RETURN 540
  174. 7540  DEF SEG = &H40:POKE &H17,&H40
  175. 7545  CLS:COLOR 3,0,1:LOCATE 12,23:PRINT "Please select which monitor to use.":LOCATE 14,28:PRINT "Color Monitor Enter <C>.":LOCATE 16,25:PRINT "Monochrome Display Enter <M>."
  176. 7550  COLOR 14,0:LOCATE 14,49:PRINT "C":LOCATE 16,51:PRINT "M":COLOR 3,0
  177. 7555  GOSUB 7605
  178. 7560  Y$=INKEY$:IF Y$="" THEN 7560 ELSE Y$=CHR$(ASC(Y$) AND &HDF)
  179. 7565  IF Y$="C" THEN CO=999:GOTO 7590
  180. 7570  IF Y$="M" THEN 7575 ELSE 540
  181. 7575  DEF SEG=64:MT=(PEEK(16) AND 48):IF MT=32 THEN GOSUB 7610
  182. 7580  DEF SEG=0:Y=PEEK(&H410):POKE &H410,(Y OR &H30)
  183. 7585  LOCATE ,,,12,13:GOTO 7600
  184. 7590  DEF SEG=64:MT=(PEEK(16) AND 48):IF MT=48 THEN GOSUB 9500
  185. 7592  DEF SEG=0: Y=PEEK(&H410):POKE &H410, (Y AND &HCF) OR &H20
  186. 7595  LOCATE ,,,7,7:GOSUB 7610
  187. 7600  LOCATE 1,1,0:SCREEN 0:WIDTH 40:WIDTH 80:RETURN 540
  188. 7605  FOR SS%=1 TO 3:SOUND 1000*SS%,1:NEXT:FOR SS%= 3 TO 1:SOUND 1000*SS%,1:NEXT:SNN$="0G110":RETURN
  189. 7610  A=1:SCREEN 1
  190. 7615  FOR X=0 TO 320 STEP 16:LINE(160,100)-(X,0),A:NEXT
  191. 7620  FOR Y=0 TO 200 STEP 10:LINE(160,100)-(320,Y),A:NEXT
  192. 7625  FOR X=320 TO 0 STEP -16:LINE(160,100)-(X,199),A:NEXT
  193. 7630  FOR Y=200 TO 0 STEP -10:LINE(160,100)-(0,Y),A:NEXT
  194. 7635  LINE(110,80)-(210,120),1,BF:A=0
  195. 7640  FOR Y=0 TO 200 STEP 10:LINE(160,100)-(0,Y),A:NEXT
  196. 7641  FOR X=0 TO 320 STEP 16:LINE(160,100)-(X,199),A:NEXT
  197. 7642  FOR Y=200 TO 0 STEP -10:LINE(160,100)-(320,Y),A:NEXT
  198. 7645  FOR X=320 TO 0 STEP -16:LINE(160,100)-(X,0),A:NEXT
  199. 7650  LOCATE 13,18:PRINT "I  S  S"
  200. 7655  LOCATE 19,12:PRINT " THE ADDRESS BOOK"
  201. 7660  LOCATE 23,7:PRINT " INTEGRATED SOFTWARE SYSTEMS "
  202. 7665  LOCATE 1,1
  203. 7670  LOCATE 21,1:PRINT "(C) COPYRIGHT 1983, E. Loh and R. Caret"
  204. 7675  REM
  205. 7680  Q$="NM160,90 C0 NM160,90 C2"
  206. 7685  DRAW"BM50,3;XQ$;R30;XQ$;D8;XQ$;L10;XQ$;D36;XQ$;R10;XQ$;D8;XQ$;L30;XQ$;U8;XQ$;R10;XQ$;U36;XQ$;L10;XQ$;U8;XQ$;"
  207. 7690  DRAW"BM50,3 R30 D8 L10 D36 R10 D8 L30 U8 R10 U36 L10 U8 "
  208. 7695  DRAW"BM150,3;XQ$;R30;XQ$;D10;XQ$;L8;XQ$;U3;XQ$;L15;XQ$;D15;XQ$;R23;XQ$;D30;XQ$;L30;XQ$;U10;XQ$;R8;XQ$;D3;XQ$;R15;XQ$;U15;XQ$;L23;XQ$;U30;"
  209. 7700  DRAW"BM150,3 R30 D10 L8 U3 L15 D15 R23 D30 L30 U10 R8 D3 R15 U15 L23 U30;"
  210. 7705  DRAW"BM250,3;XQ$;R30;XQ$;D10;XQ$;L8;XQ$;U3;XQ$;L15;XQ$;D15;XQ$;R23;XQ$;D30;XQ$;L30;XQ$;U10;XQ$;R8;XQ$;D3;XQ$;R15;XQ$;U15;XQ$;L23;XQ$;U30;"
  211. 7710  DRAW"BM250,3 R30 D10 L8 U3 L15 D15 R23 D30 L30 U10 R8 D3 R15 U15 L23 U30;"
  212. 7715  SOUND 1024,4:DRAW"BM290,3 XQ$;BM +0,-1 L2 D8 R2 BM +7,-3;XQ$;D2 L4 U6 R4 D2;XQ$;BM +3,-3 R2 D8 L2;"
  213. 7717  DRAW"BM250,3 R30 D10 L8 U3 L15 D15 R23 D30 L30 U10 R8 D3 R15 U15 L23 U30;"
  214. 7720  DRAW"BM290,3 BM +0,-1 L2 D8 R2 BM +7,-3 D2 L4 U6 R4 D2 BM +3,-3 R2 D8 L2;":SOUND 32000,10:SOUND 1024,5
  215. 7722  PAINT (55,5),2:PAINT (155,5),2:PAINT (255,5),2:COLOR 1,2
  216. 7725  FOR I= 1 TO 1000:NEXT:RETURN
  217. 8000  REM         TEMPORARY FILE
  218. 8010  OPEN FILM$ FOR INPUT AS #3:IF YST=1 THEN 8030
  219. 8020  INPUT #3,Y$,NRED,NN,FILE$,FIL$,PT$,SNN$,LP1,LP$,T1$,SND$,TN,F2$
  220. 8025  FOR I=1 TO 36:INPUT #3, ZK(I):NEXT:CLOSE #3:GOTO 8050
  221. 8030  INPUT #3,Y$,NRED,NN,FIL1$,FIL2$,PT$,SNN$,LP1,LP$,T1$,SND$,TN,F2$
  222. 8035  FOR I=1 TO 36:INPUT #3, ZK(I):NEXT:CLOSE #3
  223. 8050  IF SMD$<>"" THEN SND$=SMD$
  224. 8060  RETURN
  225. 8100  DEF SEG = &H40:POKE &H17,&H40:LOCATE ,,0
  226. 8103  CLS:GOSUB 1315:COLOR 3,0,1:LOCATE 12,25:PRINT "Sound effects are normally on.":LOCATE 13,28:PRINT "To continue, enter <Y>.":LOCATE 14,22:PRINT "To disable sound effects, enter <N>."
  227. 8105  COLOR 14,0:LOCATE 13,48:PRINT "Y":LOCATE 14,55:PRINT "N":COLOR 3,0:GOSUB 10000
  228. 8110  SND$=INKEY$:IF SND$="" THEN 8110 ELSE SND$=CHR$(ASC(SND$) AND &HDF)
  229. 8115  IF SND$="N" OR SND$="Y" THEN 8120 ELSE BEEP:GOTO 8110
  230. 8120  LOCATE 14,22:PRINT SPACE$(38)
  231. 8130  LOCATE 12,15:PRINT "Enter the DISK drive where your records are stored."
  232. 8132  LOCATE 13,15:PRINT "DRIVE <A>, <B>, <C>, <D>, or <E define drive/path>":LOCATE 13,22:COLOR 14,0:PRINT "A":LOCATE 13,27:PRINT "B":LOCATE 13,32:PRINT "C":LOCATE 13,37:PRINT "D":LOCATE 13,45:PRINT "E":GOSUB 10000
  233. 8135  F$=INKEY$:IF F$="" THEN 8135
  234. 8140  IF INSTR("ABCDE",F$)<>0 THEN 8300 ELSE BEEP:GOTO 8135
  235. 8150  SMD$=SND$:ARR$=CHR$(17)+CHR$(196)+CHR$(217):O$=CHR$(218)+CHR$(196)+CHR$(191):O1$=CHR$(179)+" "+CHR$(179):O2$=CHR$(192)+CHR$(196)+CHR$(217):ON ERROR GOTO 1010
  236. 8200  OPEN "TEMPOR.TEM" FOR OUTPUT AS #1:WRITE #1, FILE$,FILM$,FIL$:CLOSE #1:RETURN
  237. 8300  SP$=SPACE$(70):IF F$="E" THEN 8305 ELSE F$=F$+":":RETURN
  238. 8305  FF$="Y":LOCATE 12,5:PRINT SP$:PRINT SP$:LOCATE 18,5:PRINT SP$
  239. 8310  LOCATE 12,31:PRINT "Enter:  <d:>\path\":LOCATE 14,38:INPUT F$
  240. 8320  COLOR 11,0:LOCATE 18,30:PRINT "Confirm:  [Y] OR <N>" :COLOR 14,0:LOCATE 18,41:PRINT "Y":LOCATE 18,48:PRINT "N":COLOR 3,0:GOSUB 10020
  241. 8330  Y$=INKEY$:IF Y$="" THEN 8330 ELSE Y$=CHR$(ASC(Y$) AND &HDF)
  242. 8340  IF Y$="N" THEN BEEP:GOTO 8305
  243. 8350  IF RIGHT$(F$,1)="\" THEN RETURN ELSE F$=F$+"\":RETURN
  244. 9000  REM
  245. 9010  REM             WRAPING THINGS UP
  246. 9020  REM
  247. 9025  X3$="FILE = ":X4$=SPACE$(33):X1$="SAVING FILE"
  248. 9120  GOSUB 1310
  249. 9150  LOCATE  6,22:PRINT "Do you want to save the working data?":LOCATE 8,33:PRINT "<Y>es or <N>o?":COLOR 14,0:LOCATE 8,34:PRINT "Y":LOCATE 8,43:PRINT "N":COLOR 3,0
  250. 9155  GOSUB 10020
  251. 9160  Z$=INKEY$: IF Z$="" THEN 9160 ELSE Z$=CHR$(ASC(Z$) AND &HDF)
  252. 9170  IF Z$="N" THEN GOSUB 1310:RETURN 540
  253. 9180  IF Z$="Y" THEN GOSUB 1340:DIM V$(16):Y1=7:CHAIN "ADFILES",10,ALL ELSE 9155
  254. 9500  REM
  255. 9510  CLS:LOCATE  5,27:COLOR 0,7,1:PRINT SPACE$(26):LOCATE  6,27:PRINT SPACE$(26)
  256. 9520  LOCATE  7,27:PRINT SPACE$(11);:COLOR 14,9:PRINT " THE ";:COLOR 0,7:PRINT SPACE$(10)
  257. 9530  LOCATE 8,27:PRINT SPACE$(6);:COLOR 14,9:PRINT " ADDRESS BOOK ";:COLOR 0,7:PRINT SPACE$(6):LOCATE 9,27:PRINT SPACE$(26):LOCATE 10,27:PRINT SPACE$(26)
  258. 9540  IF Z$<>"" THEN 9600
  259. 9550  COLOR 4,0:LOCATE 13,26:PRINT "INTEGRATED SOFTWARE SYSTEMS ":LOCATE 15,31:PRINT "BALTIMORE MARYLAND":COLOR 3,0
  260. 9555  LOCATE 18,18:PRINT "(C) Copyright 1983  E. L. Loh and R. L. Caret"
  261. 9560  COLOR 3,0:LOCATE 18,18:PRINT "(C) Copyright 1983  E. L. Loh and R. L. Caret"
  262. 9565  IF MT=48 THEN RETURN
  263. 9570  COLOR 14,0:COLOR 0,7:LOCATE 23,28:PRINT "HIT ANY KEY TO CONTINUE":COLOR 14,0
  264. 9580  GOSUB 1315
  265. 9590  GOSUB 6040
  266. 9595  RETURN
  267. 9600  COLOR 14,0:LOCATE 15,26:PRINT "INTEGRATED SOFTWARE SYSTEMS ":COLOR 3,0
  268. 9610  LOCATE 18,18:PRINT "(C) Copyright 1983  E. L. Loh and R. L. Caret"
  269. 9615  GOSUB 6085
  270. 9620  IF Z$="" THEN 9630 ELSE LOCATE 23,22:COLOR 1,7:PRINT "PLEASE WAIT, LOADING ";Z$;" ROUTINES."
  271. 9630  GOSUB 1315
  272. 9640  RETURN
  273. 10000  IF SND$="N" THEN RETURN ELSE FOR A%=1 TO 3:SOUND 1000*A%,1:NEXT:FOR A%=3 TO 1 STEP -1:SOUND 1000*A%,1:NEXT:RETURN
  274. 10010  IF SND$="N" THEN RETURN ELSE FOR A%=1 TO 4:SOUND  500*A%,2:NEXT:RETURN
  275. 10020  IF SND$="N" THEN RETURN ELSE BEEP:RETURN
  276. 40000  DEF SEG: SUBRT$ = STRING$(160,32): SUBLC% = VARPTR(SUBRT$): ADLOC = PEEK(SUBLC% +1) +PEEK(SUBLC% +2)*256: BLOAD "ADDIR",ADLOC
  277. 40010  DIM FDAT$(111):NDAT=0
  278. 40020  FCB$=STRING$(33,32): DTA$=STRING$(33,32): FR$=STRING$(12,32): CT%=0: FOR I=0 TO 111:FDAT$(I)=FR$:NEXT
  279. 40030  ADLOC = PEEK(SUBLC% +1) +PEEK(SUBLC% +2)*256
  280. 40040  CALL ADLOC(F$,FCB$,DTA$,FDAT$(0),CT%)
  281. 40050  FOR I=0 TO CT%-1
  282. 40060  IF RIGHT$(FDAT$(I),3)="DAT" THEN NDAT=NDAT+1:PRINT LEFT$(FDAT$(I),8);SPC(2);
  283. 40070  NEXT
  284. 40080  RETURN
  285.